perm filename XGPSYN.SAI[PIX,HPM]29 blob
sn#424556 filedate 1979-03-12 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00015 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 DEFINE MAXESCAPE=0 comment set to zero for XGPSYN, ≥20 FOR XGPSYG
C00016 00003 DBUG←FALSE
C00018 00004 CHAN←GETCHAN
C00022 00005 FPN←1 FPNR←0 S←"" PN←2
C00025 00006 DO
C00036 00007 IF PAGE ∧ PN>0 THEN
C00038 00008 comment assemble line of text
C00039 00009 comment calculate height of line
C00049 00010 comment assemble line
C00050 00011 IFC MAXESCAPE>0 THENC
C00052 00012 IFC MAXESCAPE>0 THENC ["G"] BEGIN "GRAPHICS ESCAPE"
C00069 00013 IFC MAXESCAPE>0 THENC
C00071 00014 IFC MAXESCAPE>0 THENC ESCHIT←1 ENDC
C00082 00015 comment display page
C00086 ENDMK
C⊗;
DEFINE MAXESCAPE=0; comment set to zero for XGPSYN, ≥20 FOR XGPSYG;
BEGIN IFC MAXESCAPE>0 THENC "XGPSYG" ELSEC "XGPSYN" ENDC;
REQUIRE 7500 STRING_SPACE;
IFC MAXESCAPE>0 THENC
REQUIRE "GRASET.SAI[GRA,HPM]" SOURCE_FILE;
REQUIRE "PGHDR.SAI[VIS,HPM]" SOURCE_FILE;
STRING ESCAPE,ESCHIT; INTEGER NESCAPE; STRING ARRAY ESCCOM[1:MAXESCAPE];
INTEGER ARRAY ESCX,ESCY,ESCF,ESCL[1:MAXESCAPE]; ENDC
REQUIRE "FNTHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "SYNSUB.REL[PIX,HPM]" LOAD_MODULE;
EXTERNAL PROCEDURE HELPER;
EXTERNAL PROCEDURE NOCHAN;
EXTERNAL PROCEDURE FEWCHN(INTEGER N);
EXTERNAL PROCEDURE FIRST;
EXTERNAL PROCEDURE FIRST1;
EXTERNAL PROCEDURE FIRST2;
EXTERNAL PROCEDURE FIRST3;
EXTERNAL PROCEDURE CRLF;
EXTERNAL PROCEDURE FILNM;
EXTERNAL PROCEDURE FONTNO(INTEGER N);
BOOLEAN PRNT,XGP,DBUG,SPOOLFLAG,WHITELET,OWNCH,HELPACT,AUTOCR;
INTEGER NCOPY;
INTEGER ARRAY FHD[0:'177,0:'203];
INTEGER FNTN,SFNTN,EOF,FTH,FTB,XPOS,YPOS,XLINE,CHAN,DUN,PN,LASTFF,BASE,SBASE;
INTEGER INTERCHAR,UINTERCHAR,SINTERCHAR,LINLEN, LISTLO,LISTHI, LASTUSETI;
INTEGER XCMP,YCMP,YOFF,XOFF,BMAR,RMAR,LMAR,TMAR,PMAR,DENS,LUND,SDENS;
INTEGER NCHN,I,J,K,NUMCH,TXTPNT;
INTEGER PN1,PN2,PN3,PN4;
INTEGER XSHIFT,YSHIFT;
DEFINE PAGEMAX=500;
INTEGER ARRAY PNS[0:PAGEMAX];
REAL FPN,FPNR;
STRING INSTR,INFILE,S,SWT,SPOOLF;
SIMPLE INTEGER PROCEDURE BYT(INTEGER PNT);
RETURN(((PNT LAND '777777) LSH 6) LOR ('77 - (PNT LSH -30)));
SIMPLE INTEGER PROCEDURE UCONV(INTEGER I);
RETURN(IF I>'140 ∧ I≤'172 THEN I LAND '137 ELSE I);
SIMPLE INTEGER PROCEDURE NXCH;
BEGIN
INTEGER T;
IF LENGTH(INSTR)=0 ∧ ¬EOF THEN INSTR←INPUT(CHAN,1);
NUMCH←NUMCH+1; IDPB(T←LOP(INSTR),TXTPNT);
EOF←EOF ∨ NUMCH≥LASTUSETI;
RETURN(T);
END;
PROCEDURE SWITCHES(STRING FNTNMS);
BEGIN
STRING PROCEDURE SKIPTO(INTEGER DELIM);
BEGIN
STRING RET;
RET←"";
WHILE LENGTH(FNTNMS)>0 ∧ FNTNMS≠DELIM ∧ FNTNMS≠"/" ∧ FNTNMS≠"#"
DO RET←RET&LOP(FNTNMS);
RETURN(RET);
END;
INTEGER FOO;
WHILE LENGTH(FNTNMS)>0 DO
BEGIN
WHILE LENGTH(FNTNMS)>0 ∧ LOP(FNTNMS)≠"/" DO;
IF EQU(FNTNMS[1 TO 1],"F") THEN
BEGIN
INTEGER FTNO; STRING FTNM;
SKIPTO("=");
IF FNTNMS="#" THEN FTNO←INTSCAN(FNTNMS,FOO) ELSE FTNO←0;
FNTNMS←FNTNMS[2 TO ∞];
FTNM←SKIPTO("=");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
IF HELPACT THEN BEGIN FONTNO(FTNO); PRINT(FTNM," "); END;
WHILE FNTSEL(FTNO,FTNM,FHD[FTNO,0])<0 DO
BEGIN
PRINT("COULDN'T GET ",DEVPRS,":",FILPRS); CRLF;
PRINT("Try again:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
FTNM←INCHWL;
IF HELPACT THEN BEGIN FONTNO(FTNO); PRINT(FTNM); END;
END;
IF FNTNMS="=" THEN
BEGIN
INTEGER ARRAY TERM[0:'177]; INTEGER I;
FNTNMS←FNTNMS[2 TO ∞];
ARRCLR(TERM);
DO BEGIN I←LOP(FNTNMS); TERM[I]←TERM[I]+1; END UNTIL TERM[I]≥2;
END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"RE") THEN
BEGIN
INTEGER FTNO; STRING FTNM;
SKIPTO("=");
IF FNTNMS="=" THEN
BEGIN
FNTNMS←FNTNMS[2 TO ∞];
NCOPY←INTSCAN(FNTNMS,FOO);
END
ELSE NCOPY←2;
IF HELPACT THEN PRINT("REPEAT=",NCOPY," ");
END
ELSE IF EQU(FNTNMS[1 TO 2],"TM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN TMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("TMAR=",TMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"PM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN PMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("PMAR=",PMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"BM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN BMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("BMAR=",BMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"LM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN LMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("LMAR=",LMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"RM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN RMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("RMAR=",RMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"XL") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN XLINE←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("XLINE=",XLINE," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"XO") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN XOFF←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("XOFF=",XOFF," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"YO") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN YOFF←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("YOFF=",YOFF," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"IN") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN UINTERCHAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("INTERCHAR=",UINTERCHAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"XS") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN XSHIFT←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("XSHIFT=",XSHIFT," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"YS") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN YSHIFT←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("YSHIFT=",YSHIFT," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"XG") THEN
BEGIN
SKIPTO("/");
XGP←TRUE;
IF HELPACT THEN PRINT("XGP ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"NOX") THEN
BEGIN
SKIPTO("/");
XGP←FALSE;
AUTOCR←TRUE;
IF HELPACT THEN PRINT("NOXGP ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"AUT") THEN
BEGIN
SKIPTO("/");
AUTOCR←TRUE;
IF HELPACT THEN PRINT("AUTOCR ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"NOA") THEN
BEGIN
SKIPTO("/");
AUTOCR←FALSE;
IF HELPACT THEN PRINT("NOAUTOCR ");
END
IFC MAXESCAPE>0 THENC
ELSE IF EQU(FNTNMS[1 TO 3],"ESC") THEN
BEGIN
ESCAPE←"";
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN
WHILE LENGTH(FNTNMS)>0∧FNTNMS≠"/" DO ESCAPE←ESCAPE&LOP(FNTNMS);
IF HELPACT THEN PRINT("ESCAPE=",ESCAPE," ");
END
ENDC
ELSE IF EQU(FNTNMS[1 TO 1],"U") THEN
BEGIN
INTEGER FOO;
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN IF HELPACT THEN PRINT("USETI ");
USETI(CHAN,LASTUSETI←INTSCAN(FNTNMS,FOO));
LASTUSETI←(LASTUSETI-1)*'200*5; comment terminating character;
FNTNMS←"";
WHILE ¬EOF DO FNTNMS←FNTNMS&INPUT(CHAN,1);
LASTFF←10000; END;
END;
END;
END;
PROCEDURE SETOFFSET;
CASE DENS OF
BEGIN
["T"] BEGIN YOFF←-36; XOFF←0; END;
["B"] BEGIN YOFF←-YSHIFT; XOFF←-36-XSHIFT; END;
["E"] BEGIN YOFF←TMAR; XOFF←LMAR; END;
["H"] BEGIN YOFF←TMAR+(FPN-PN+FPNR)*(480*4-30)-20;
XOFF←((LMAR-20) MIN (RMAR-3*512)) MAX -10; END;
["F"] BEGIN YOFF←TMAR-((512*4-PMAR)%2 MAX 0)+FPNR*512*4;
XOFF←((LMAR-20) MIN (RMAR-3*480)) MAX -10; END;
["D"] BEGIN YOFF←TMAR+FPNR*481*4-20; XOFF←((LMAR-20) MIN (RMAR-3*512)) MAX -10;
END
END;
STRING PROCEDURE GETINCHWL;
BEGIN
PRELOAD_WITH 0; OWN INTEGER ARRAY INDEX[1:1];
IF INDEX[1]=0 ∧ SPOOLFLAG ∧ (LISTLO>LISTHI ∨ (EOF ∧ LISTLO>LASTFF+1)) THEN
BEGIN
SPOOLFLAG←FALSE;
PRINT("listing finished"); CRLF; DENS←SDENS;
CASE DENS OF
BEGIN
["D"] BEGIN PRINT("FIRST PAGE #"); IF HELPACT THEN FIRST; PRINT(":"); END;
["F"]["B"]["E"] BEGIN PRINT("PAGE #"); IF HELPACT THEN FIRST; PRINT(":"); END;
ELSE
BEGIN PRINT("PAGE"); IF HELPACT THEN BEGIN FIRST1; FIRST; END; PRINT(":"); END
END;
END;
IF SPOOLFLAG THEN
BEGIN
INDEX[1]←(INDEX[1]+1) MOD 2;
IF INDEX[1]=1 THEN LISTLO←LISTLO+1;
RETURN(IF INDEX[1]=1 THEN CVS(LISTLO-1) ELSE "X");
END
ELSE RETURN(INCHWL);
END;
DBUG←FALSE;
HELPACT←FALSE;
OWNCH←SYNMAP(1)<0;
FOR I←0 STEP 1 UNTIL '177 DO FHD[I,FNTHIG]←-1;
IF OWNCH THEN
BEGIN
INTEGER I;
PRINT("Too few synthesizer channels, output will be on your screen"); CRLF;
FOR I←'30 STEP 1 UNTIL '37 DO RDDCHN(I);
END
ELSE
BEGIN
NCHN←0; FOR I←0 STEP 1 UNTIL 2 DO IF SYNMAP(I)>0 THEN NCHN←NCHN+1;
IF NCHN=0 THEN NOCHAN ELSE IF NCHN<3 THEN FEWCHN(NCHN);
END;
BREAKSET(1,"","A"); BREAKSET(1,'0&'177&'12&'14,"I");
BREAKSET(1,"","O"); BREAKSET(1,"","Z");
DDINIT;
NCOPY←1;
LASTUSETI←2↑34;
IFC MAXESCAPE>0 THENC ESCAPE←"⊂⊗⊃"; ENDC
TMAR←200;
PMAR←1796;
BMAR←200;
LMAR←200;
RMAR←1650;
AUTOCR←TRUE;
XLINE←4;
XSHIFT←YSHIFT←0;
UINTERCHAR←0;
SPOOLFLAG←FALSE;
WHITELET←FALSE;
ARRCLR(PNS,-1);
BEGIN "FILE"
DEFINE FSIZE=10000;
INTEGER FOO,HIG,POS,I,J; INTEGER ARRAY FONT[0:FSIZE];
STRING FNTNMS; BOOLEAN PAGE;
FCACHE(FONT[0],FSIZE);
FNTSEL(0,"GACS25.FNT[XGP,SYS]",FHD[0,0]); comment select the default font;
CHAN←GETCHAN;
START_CODE TTCALL '10,0; END; comment RESCAN to read command line;
TTYUP(TRUE); S←INCHWL; TTYUP(FALSE);
WHILE LENGTH(S)≠0 ∧ S[1 TO 1]≠";" DO S←S[2 TO ∞];
IF LENGTH(S)>0 THEN S←S[2 TO ∞] ELSE
BEGIN PRINT("Type ?<cr> for help"); CRLF; CRLF; END;
DO
BEGIN
STRING SF;
IF LENGTH(S)=0 THEN
BEGIN
FILNM; IF HELPACT THEN FIRST3; PRINT(":");
TTYUP(TRUE); S←INCHWL; TTYUP(FALSE);
END;
SF←""; WHILE LENGTH(S)>0 ∧ S[1 TO 1]≠"/" DO SF←SF&LOP(S);
EOF←TRUE;
IF SF="?" THEN BEGIN HELPACT←TRUE; HELPER; END ELSE
BEGIN "FILE"
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".XGP");
PRSFIL(SF);
OPEN(CHAN,DEVPRS,0,19,0,500,FOO,EOF);
LOOKUP(CHAN,FILPRS,EOF);
END "FILE";
IF EOF THEN
BEGIN "EOF"
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(SF);
OPEN(CHAN,DEVPRS,0,19,0,500,FOO,EOF);
LOOKUP(CHAN,FILPRS,EOF);
END "EOF";
IF EOF THEN S←"";
END UNTIL ¬EOF;
BEGIN
STRING FOO,FN2;
FILDEF(FOO,FOO,FN2,FOO,FOO);
XGP←(FN2="XGP");
END;
IF XGP THEN AUTOCR←FALSE; comment don't break at EOL in XGP files;
NUMCH←0; TXTPNT←POINT(7,DBUF,-1);
IF LENGTH(S)>0 THEN SWITCHES(S); comment parse any spooler style switches;
LASTFF←0; PNS[0]←(0 LSH 29) LOR (0 LSH 22) LOR 0;
IF XGP THEN
BEGIN
INTEGER NX;
SPOOLF←"XS "&DEVPRS&":"&FILPRS&"/NOTITLE/NOHEAD"&'15&'12;
SWT←"";
WHILE (NX←NXCH)≠'14 DO IF ¬(NX='15∨NX='12∨NX=" ") THEN SWT←SWT&NX;
SWITCHES(SWT);
IF LMAR=50∧PMAR=0 THEN BEGIN LMAR←120; TMAR←120; END; comment TEX defaults;
IF LMAR=0 THEN LMAR←150; comment LMAR=0, PUB default;
IF PMAR=0 THEN PMAR←2200-TMAR-BMAR; comment can't support indefinite pages;
PNS[0]←(0 LSH 29) LOR (0 LSH 22) LOR NUMCH;
END;
FNTN←PNS[0] LSH -29; FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
INTERCHAR←(PNS[0] LSH -22) LAND '177;
CRLF;
FPN←1; FPNR←0; S←""; PN←2;
IF OWNCH THEN BEGIN PRINT("Half density"); CRLF; DENS←"H"; END
ELSE BEGIN PRINT("Full density"); CRLF; DENS←"F"; END;
WHILE TRUE DO
BEGIN "DENSITY"
XCMP←IF DENS="B"∨DENS="T"∨DENS="E" THEN 1 ELSE IF DENS="D" THEN 6 ELSE 3;
YCMP←IF DENS="B"∨DENS="T"∨DENS="E" THEN 1 ELSE IF DENS="H" THEN 2 ELSE 4;
BEGIN "PICTURE"
INTEGER HI,WI,BI;
SAFE INTEGER ARRAY PIC[0:PIXDIM(HI←IF DENS="B" THEN TMAR+PMAR+BMAR ELSE
IF DENS="T" THEN RMAR
ELSE 481,
WI←IF DENS="B" THEN 1700+37 ELSE
IF DENS="T" THEN
(TMAR+PMAR+BMAR+37) MIN 1700
ELSE 512,
BI←IF DENS="H" THEN 3
ELSE IF DENS="F" THEN 4
ELSE IF DENS="D" THEN 5
ELSE 1)];
MAKPIX(HI,WI,BI,PIC[0]);
IF ¬OWNCH THEN
BEGIN
NCHN←0;
FOR I←0 STEP 1 UNTIL PIC[BYBI]-1 DO
IF SYNMAP(I)>0 THEN NCHN←NCHN+1;
IF NCHN<PIC[BYBI] THEN
BEGIN
IF NCHN=0 THEN PRINT("No synthesizer channels.") ELSE
PRINT(PIC[BYBI]-NCHN," synthesizer channel",
IF PIC[BYBI]-NCHN=1 THEN "" ELSE "s"," too few.");
CRLF;
END;
END;
DO
BEGIN "PAGES"
INTEGER FOO;
IF ¬SPOOLFLAG∧¬OWNCH THEN
IF DENS="D" THEN
BEGIN PRINT("FIRST PAGE #"); IF HELPACT THEN FIRST; PRINT(":"); END
ELSE IF DENS="F" ∨ DENS="B" ∨ DENS="E" THEN
BEGIN PRINT("PAGE #"); IF HELPACT THEN FIRST; PRINT(":"); END
ELSE
BEGIN PRINT("PAGE"); IF HELPACT THEN BEGIN FIRST1; FIRST; END; PRINT(":"); END;
TTYUP(TRUE); S←GETINCHWL; TTYUP(FALSE);
IF LENGTH(S)=0 THEN
BEGIN
INTEGER IPN;
IPN←FPN;
FPNR←FPN-IPN;
FPN←IPN;
PAGE←TRUE;
END
ELSE IF (S LAND '137)="L" THEN
BEGIN
INTEGER I;
FOR I←'30 STEP 1 UNTIL '37 DO RDDCHN(I);
IF LENGTH(S)≤1 THEN BEGIN LISTLO←1;
LISTHI←(IF EOF THEN LASTFF+1 ELSE 9999); END
ELSE
BEGIN
I←LOP(S); WHILE LENGTH(S)>0∧(S="("∨S=" ") DO I←LOP(S);
LISTLO←INTSCAN(S,FOO);
WHILE LENGTH(S)>0∧(S=":"∨S=" ") DO I←LOP(S);
LISTHI←IF S="*" THEN 9999 ELSE INTSCAN(S,FOO);
IF LISTHI=0 THEN LISTHI←LISTLO;
END;
PRINT("listing ",LISTLO,":",
IF LISTHI=9999 THEN "*" ELSE CVS(LISTHI)," ..."); CRLF;
SDENS←DENS;
DENS←"B";
PN←-1;
SPOOLFLAG←TRUE;
PAGE←FALSE;
END
ELSE IF S="/" THEN
BEGIN
SWITCHES(S);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="X" THEN
BEGIN
IF DENS="E" THEN
BEGIN
OUTSTR("White on black?");
SCREEN(0,0,1,1); DDINIT; LITEN;
IF (INCHWL LAND '137)="Y" THEN RECTAN(0,0,1,1);
VIDONE(PIC[0],'77);
OUTSTR("SIZE(-5 to 5):");
FOR I←1 STEP 1 UNTIL NCOPY DO XGPUP(CVD(INCHWL));
END
ELSE
FOR I←1 STEP 1 UNTIL NCOPY DO
IF DENS="B" THEN VIDXGP(PIC[0],YOFF+YSHIFT,XOFF+XSHIFT,
TMAR+PMAR+BMAR-J) ELSE
IF DENS="T" THEN VIDXGP(PIC[0],0,YOFF,RMAR)
ELSE VIDXGP(PIC[0],0,0,PIC[PCLN]);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="V" THEN
BEGIN
INTEGER I,J;
BEGIN
SAFE INTEGER ARRAY DDB[2:(PIC[BYBI] MAX 2),
0:IF DENS="B"∨DENS="T"∨OWNCH
THEN 0 ELSE DDSIZ];
DDINIT;
IF ¬OWNCH THEN
BEGIN
MAPGRY(IF DENS="D" THEN 1.5 ELSE 1,PIC[BYBI],TRUE);
FOR I←2 STEP 1 UNTIL PIC[BYBI] DO DDSTOR(DDB[I,0]);
CASE PIC[BYBI] OF
BEGIN
[1] VID1(PIC[0],DBUF);
[3] VID3(PIC[0],DDB[3,0],DDB[2,0],DBUF);
[4] VID4(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF);
[5] VID5(PIC[0],DDB[5,0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF)
END;
FOR J←1,1 DO DPYUP(SYNMAP(0));
FOR I←1 STEP 1 UNTIL PIC[BYBI]-1 DO IF SYNMAP(I)>0 THEN
FOR J←1,1 DO DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
PRINT(" DONE"); CRLF;
END
ELSE
BEGIN
VIDONE(PIC[0],IF PIC[BYBI]>2 THEN '7776 ELSE '7777);
DPYUP(-1); DPYUP(-1);
END;
END;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="O" THEN
BEGIN
PRINT("OUTPUT FILE NAME:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
UNGRAY(PIC[0]);
PUTPFL(PIC[0],INCHWL);
GRAY(PIC[0]);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="K" THEN
BEGIN
INTEGER I;
IF OWNCH THEN ERASE(-1) ELSE MAPGRY(-1,0,TRUE);
FOR I←'30 STEP 1 UNTIL '37 DO RDDCHN(I);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="Q" THEN
BEGIN
LODED(SPOOLF);
CALL(0,"EXIT");
PAGE←FALSE;
END
ELSE IF (S LAND '137)="W" THEN
BEGIN
WHITELET←¬WHITELET;
IF WHITELET THEN PRINT("White letters on black")
ELSE PRINT("Black letters on white");
CRLF;
BEGIN
INTEGER I,J,K;
INTEGER ARRAY TRANS[0:PIC[BMAX]];
J←PIC[BMAX]; K←J-(J LSH -1);
FOR I←0 STEP 1 UNTIL J DO
TRANS[I]←I XOR K;
PERBIT(PIC[0],TRANS[0]);
END;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="C" THEN
BEGIN
INTEGER I;
OWNCH←TRUE;
PRINT("on your display"); CRLF;
PRINT("half density"); DENS←"H"; CRLF;
FOR I←'30 STEP 1 UNTIL '37 DO RDDCHN(I);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="S" THEN
BEGIN
OWNCH←FALSE;
PRINT("on video synthesizer"); CRLF;
MAPGRY(1,1,TRUE);
PAGE←FALSE;
END
ELSE IF S="?" THEN
BEGIN
HELPACT←TRUE;
HELPER;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="B" ∨ (S LAND '137)="T" ∨ (S LAND '137)="F"
∨ (S LAND '137)="D" ∨ (S LAND '137)="H" ∨ (S LAND '137)="E" THEN
BEGIN
S←S LAND '137;
PRINT(IF S="B" THEN "bitwise resolution" ELSE
IF S="E" THEN "enormous resolution" ELSE
IF S="T" THEN "transposed bitwise resolution" ELSE
IF S="F" THEN "full density"
ELSE IF S="H" THEN "half density"
ELSE "double density"); CRLF;
DENS←S;
PN←-1;
PAGE←FALSE;
END
ELSE
BEGIN
INTEGER IPN;
FPN←REALSCAN(S,FOO);
IPN←FPN;
FPNR←FPN-IPN+ABS(REALSCAN(S,FOO));
FPN←IPN;
PAGE←TRUE;
END;
IF PAGE THEN BEGIN PN←FPN; SETOFFSET; END;
IF PAGE ∧ PN>0 THEN
BEGIN "NONZERO"
IF EOF ∨ PN≠LASTFF+1 THEN
BEGIN
INTEGER PNSLASTFF;
LASTFF←PN-1;
LASTFF←LASTFF MIN PAGEMAX;
WHILE LASTFF>0 ∧ PNS[LASTFF]=-1 DO LASTFF←LASTFF-1;
PNSLASTFF←PNS[LASTFF] LAND '17777777;
EOF←FALSE;
USETI(CHAN,1+PNSLASTFF%('200*5));
EOF←EOF ∨ PNSLASTFF≥LASTUSETI;
INSTR←""; NUMCH←(PNSLASTFF%('200*5))*'200*5;
FOR I←(PNSLASTFF MOD ('200*5)) STEP -1 UNTIL 1 DO NXCH;
FNTN←PNS[LASTFF] LSH -29;
FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
INTERCHAR←(PNS[LASTFF] LSH -22) LAND '177;
END;
WIPE(PIC[0],0);
comment assemble line of text;
XPOS←LMAR; YPOS←TMAR;
BASE←0;
WHILE ¬EOF ∧ LASTFF<(IF DENS="D" THEN PN+1 ELSE PN) DO
BEGIN "NOTEOF"
INTEGER I,J,LC,YU,YL;
YL←0; YU←0;
PRNT←LASTFF≥PN-1;
IF DENS="D" ∧ LASTFF=PN THEN
XOFF←(((LMAR-20) MIN (RMAR-3*512))MAX -10)-512*3;
IF DENS="D" ∧ LASTFF≠PN THEN
XOFF←((LMAR-20) MIN (RMAR-3*512)) MAX -10;
comment calculate height of line;
SBASE←BASE; SFNTN←FNTN; XPOS←LMAR; SINTERCHAR←INTERCHAR;
TXTPNT←POINT(7,DBUF,-1); DUN←FALSE; LINLEN←0;
IFC MAXESCAPE>0 THENC ESCHIT←0; NESCAPE←0; ENDC
WHILE ¬DUN∧¬EOF DO
BEGIN "HEIGHT"
CASE PN1←NXCH OF
BEGIN
[0]
QUICK_CODE
SETO 1,;
IBP 1,TXTPNT; comment ADJBP;
MOVEM 1,TXTPNT;
END;
['177] CASE PN2←NXCH OF
BEGIN
['1] CASE PN3←NXCH OF
BEGIN
[0][1][2][3][4][5][6][7][8]
[9][10][11][12][13][14][15]
BEGIN
FNTN←PN3;
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←0;
END;
['43] BASE←((NXCH LSH 29) ASH -29);
['52] BASE←BASE+((NXCH LSH 29) ASH -29);
['40] XPOS←NXCH*128+NXCH;
['41]
BEGIN
YU←YU MAX (((PN4←NXCH) LSH 29) ASH -29);
YL←YL MIN ((PN4 LSH 29) ASH -29);
XPOS←XPOS+NXCH*128+NXCH;
END;
['42] BEGIN YU←YU+FTB+XLINE+NXCH; DUN←TRUE; END;
['44] ;
['45] FOR I←NXCH STEP -1 UNTIL 1 DO NXCH;
['46] ;
['47]
BEGIN
INTEGER YP;
YP←((NXCH LSH 29) ASH -29);
YU←YU MAX YP; YL←YL MIN YP;
END;
['50] INTERCHAR←NXCH;
['51]
BEGIN
INTEGER YP;
PN4←NXCH;
YP←((NXCH LSH 29) ASH -29);
YU←YU MAX (YP+PN4); YL←YL MIN YP;
END;
ELSE
END;
[2] XPOS←XPOS+((NXCH LSH 29) ASH -29);
[3] YPOS←NXCH*128+NXCH;
[4] FOR I←1 STEP 1 UNTIL 11 DO NXCH;
[5]
BEGIN
FNTN←NXCH;
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←0;
END;
[6]
BEGIN
INTEGER PREVHT;
PREVHT←BASE+FTB;
FNTN←NXCH;
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←(IF LINLEN=0 THEN 0 ELSE PREVHT-FTB);
END;
[7]['10]['13]
['16]['17]['20]['21]['22]['23]['24]['25]['26]
['27]['30]['31]['32]['33]['34]['35]['36]['37] ;
ELSE
IF (XPOS+(FHD[FNTN,PN2] LSH -18)+INTERCHAR+UINTERCHAR)
≤RMAR ∨ ¬AUTOCR THEN
BEGIN
IFC MAXESCAPE>0 THENC
IF ESCHIT<LENGTH(ESCAPE) THEN
IF PN2=ESCAPE[ESCHIT+1 FOR 1] THEN
BEGIN
ESCHIT←ESCHIT+1;
IF ESCHIT=1 THEN
BEGIN
ESCX[NESCAPE+1]←XPOS;
ESCY[NESCAPE+1]←YPOS+FHD[FNTN,FNTHIG]%2;
ESCF[NESCAPE+1]←BYT(TXTPNT);
END;
IF ESCHIT=LENGTH(ESCAPE) THEN
BEGIN
NESCAPE←NESCAPE+1;
ESCX[NESCAPE]←(ESCX[NESCAPE]+XPOS
+(FHD[FNTN,PN2] LSH -18)
+INTERCHAR+UINTERCHAR)%2;
ESCY[NESCAPE]←(ESCY[NESCAPE]+YPOS+FHD[FNTN,FNTHIG]%2)%2;
ESCL[NESCAPE]←BYT(TXTPNT);
ESCCOM[NESCAPE]←"";
IF (NESCAPE LAND 1)=0 THEN ESCCOM[NESCAPE-1]←
ESCCOM[NESCAPE-1][2 TO ∞-LENGTH(ESCAPE)+1];
ESCHIT←0;
END;
END
ELSE ESCHIT←0;
IF (NESCAPE LAND 1)=1 THEN
ESCCOM[NESCAPE]←ESCCOM[NESCAPE]&PN2;
ENDC
XPOS←XPOS+(FHD[FNTN,PN2] LSH -18)+INTERCHAR+UINTERCHAR;
YU←YU MAX (FTH-BASE-FTB); YL←YL MIN (-FTB-BASE);
LINLEN←LINLEN+1;
END
ELSE DUN←TRUE
END;
['15] XPOS←LMAR;
['11]
BEGIN
INTEGER BLANW;
BLANW←(FHD[FNTN," "] LSH -18)+INTERCHAR+UINTERCHAR;
XPOS←LMAR+((9*BLANW+XPOS-LMAR-1)%(8*BLANW))*8*BLANW;
LINLEN←LINLEN+1;
END;
ELSE
IF (XPOS+(FHD[FNTN,PN1] LSH -18)+INTERCHAR+UINTERCHAR)≤RMAR
∨ ¬AUTOCR THEN
BEGIN
IFC MAXESCAPE>0 THENC
IF ESCHIT<LENGTH(ESCAPE) THEN
IF PN1=ESCAPE[ESCHIT+1 FOR 1] THEN
BEGIN
ESCHIT←ESCHIT+1;
IF ESCHIT=1 THEN
BEGIN
ESCX[NESCAPE+1]←XPOS;
ESCY[NESCAPE+1]←YPOS+FHD[FNTN,FNTHIG]%2;
ESCF[NESCAPE+1]←BYT(TXTPNT);
END;
IF ESCHIT=LENGTH(ESCAPE) THEN
BEGIN
NESCAPE←NESCAPE+1;
ESCX[NESCAPE]←(ESCX[NESCAPE]+XPOS
+(FHD[FNTN,PN1] LSH -18)
+INTERCHAR+UINTERCHAR)%2;
ESCY[NESCAPE]←(ESCY[NESCAPE]+YPOS+FHD[FNTN,FNTHIG]%2)%2;
ESCL[NESCAPE]←BYT(TXTPNT);
ESCCOM[NESCAPE]←"";
IF (NESCAPE LAND 1)=0 THEN ESCCOM[NESCAPE-1]←
ESCCOM[NESCAPE-1][2 TO ∞-LENGTH(ESCAPE)+1];
ESCHIT←0;
END;
END
ELSE ESCHIT←0;
IF (NESCAPE LAND 1)=1 THEN
ESCCOM[NESCAPE]←ESCCOM[NESCAPE]&PN1;
ENDC
XPOS←XPOS+(FHD[FNTN,PN1] LSH -18)+INTERCHAR+UINTERCHAR;
LINLEN←LINLEN+1;
IF PN1='12 ∨ PN1='14 THEN
BEGIN
IF PN1='14 THEN
BEGIN
LASTFF←LASTFF+1;
IF LASTFF≤PAGEMAX THEN
PNS[LASTFF]←(FNTN LSH 29) LOR
(INTERCHAR LSH 22) LOR NUMCH;
PRINT(LASTFF," ");
END;
DUN←TRUE;
END;
YU←YU MAX (FTH-BASE-FTB); YL←YL MIN (-FTB-BASE);
END
ELSE DUN←TRUE
END;
END "HEIGHT";
BASE←SBASE;
FNTN←SFNTN; FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
INTERCHAR←SINTERCHAR;
comment assemble line;
IF PRNT THEN
BEGIN "ASSEMBLE"
IFC MAXESCAPE>0 THENC
FOR I←2 STEP 2 UNTIL NESCAPE DO IF LENGTH(ESCCOM[I-1])>0 THEN
BEGIN "ESCAPE CODE INTERPRETER"
INTEGER J,K,X0,Y0,ESCC; STRING COM;
COM←ESCCOM[I-1]; ESCCOM[I-1]←"";
X0←(ESCX[I]+ESCX[I-1])%2; Y0←(ESCY[I]+ESCY[I-1])%2;
CASE (ESCC←LOP(COM)) OF
BEGIN
ENDC
IFC MAXESCAPE>0 THENC ["G"] BEGIN "GRAPHICS ESCAPE"
INTEGER XZ,YZ,XPL,YPL,XPH,YPH;
XZ←1200; YZ←900;
IF COM="[" THEN BEGIN K←LOP(COM);
IF COM≠"%" THEN X0←8.5*200/2 ELSE K←LOP(COM);
IF COM≠"," THEN X0 ← X0+REALSCAN(COM,K)*200; IF COM="," THEN K←LOP(COM);
IF COM≠"%" THEN Y0 ← 11*200/2 ELSE K←LOP(COM);
IF COM≠"]" THEN Y0 ← Y0-REALSCAN(COM,K)*200;
IF LOP(COM)≠"]" THEN PRINT("syntax error ",COM,'15&'12); END;
IF COM="(" THEN
BEGIN XZ←REALSCAN(COM,K)*200; YZ←REALSCAN(COM,K)*200;
IF LOP(COM)≠")" THEN PRINT("syntax error ",COM,'15&'12); END;
DO UNTIL LENGTH(COM)=0 ∨ LOP(COM)=":";
BEGIN
INTEGER ARRAY DIA[0:IF DENS="B"∨DENS="E"∨DENS="T" THEN 0 ELSE
IF DENS="H"∨DENS="D" THEN PIXDIM(YZ+YCMP-1,XZ+XCMP-1,1) ELSE
IF DENS="F" THEN PIXDIM(XZ+XCMP-1,YZ+YCMP-1,1) ELSE 0];
CASE DENS OF
BEGIN
["B"]["E"] PDDINI(PIC[0],YPL←Y0-YZ%2-YOFF,XPL←X0-XZ%2-XOFF,
YPH←Y0-YZ%2-YOFF+YZ-1,XPH←X0-XZ%2-XOFF+XZ-1);
["H"]["D"] BEGIN MAKPIX(YZ+YCMP-1,XZ+XCMP-1,1,DIA[0]);
PDDINI(DIA[0],YPL←0,XPL←0,YPH←YZ-1,XPH←XZ-1); END;
["T"] PDDINI(PIC[0],PIC[PCLN]-(XPH←(X0-XZ%2-XOFF+XZ-1)),YPL←Y0-YZ%2-YOFF,
PIC[PCLN]-(XPL←(X0-XZ%2-XOFF)),YPH←Y0-YZ%2-YOFF+YZ-1);
["F"] BEGIN MAKPIX(XZ+XCMP-1,YZ+YCMP-1,1,DIA[0]);
PDDINI(DIA[0],XPL←0,YPL←0,XPH←XZ-1,YPH←YZ-1); END
END;
PLITEN;
CASE DENS OF
BEGIN
["B"]["E"]["H"]["D"] BEGIN PSCREE(0,0,1,1); PTXTPO(0,0,1/70,1/35,0,0); END;
["F"]["T"] BEGIN PSCREE(1,0,0,1); PTXTPO(0,0,0,0,1/35,1/70); END
END;
BEGIN "PICJOB"
INTEGER ARRAY TSP[1:1];
INTEGER ARRAY TIDINGS[1:32]; INTEGER CONTROL,CONTROLNAM;
INTEGER CMD;
INTEGER NFILE; INTEGER ARRAY CHANS[0:16]; INTEGER BRCHAR,EOF,T,FLAG;
PROCEDURE RCVMESS;
comment wait to recieve a message from controlling job;
BEGIN
IF TSP[1]=0 THEN RETURN; TSP[1]←0;
IF EOF THEN
BEGIN RELEASE(CHANS[NFILE]); EOF←FALSE; NFILE←NFILE-1;
IF CHANS[NFILE]=-2 THEN EOF←TRUE; END;
IF ¬EOF THEN ARRYIN(CHANS[NFILE],TIDINGS[1],32);
END;
PROCEDURE MARKMESS; BEGIN RCVMESS; END;
REAL PROCEDURE GETREAL;
BEGIN
IF TSP[1]=32 THEN RCVMESS;
TSP[1]←TSP[1]+1;
RETURN(MEMORY[LOCATION(TIDINGS[TSP[1]]),REAL]);
END;
INTEGER PROCEDURE GETINT;
BEGIN
IF TSP[1]=32 THEN RCVMESS;
TSP[1]←TSP[1]+1;
RETURN(TIDINGS[TSP[1]]);
END;
STRING PROCEDURE GETSTRING;
BEGIN
INTEGER I,L,LL; STRING V;
LL←GETINT; L←(LL+4)%5; V←"";
FOR I←1 STEP 1 UNTIL L DO V←V&CVSTR(GETINT);
RETURN(V[1 TO LL]);
END;
PROCEDURE GETINTARRAY(REFERENCE INTEGER AR; INTEGER N);
BEGIN
INTEGER I;
FOR I←0 STEP 1 UNTIL N-1 DO MEMORY[LOCATION(AR)+I]←GETINT;
END;
CHANS[0]←-2; NFILE←1;
CHANS[NFILE]←GETCHAN;
PRSFIL(""); PRSFIL(COM);
OPEN(CHANS[NFILE],DEVPRS,8,19,0,1,BRCHAR,EOF);
LOOKUP(CHANS[NFILE],FILPRS,FLAG);
IF FLAG THEN BEGIN PRINT(" Graphics file ",COM," not found "); EOF←TRUE;
RELEASE(CHANS[NFILE]); END;
WHILE ¬EOF DO
BEGIN "GRAPHICS"
OWN REAL FXP,FYP, FXS,FYS,FDXS,FDYS;
CMD←GETINT;
CASE CMD OF
BEGIN
[KILJOB_] IF CHANS[NFILE]=-2 THEN DONE "GRAPHICS" ELSE MARKMESS;
[DISOWN_] CHANS[0]←-2;
[MARK_] MARKMESS;
[GRAFIL_]
BEGIN
EOF←FALSE;
IF (CHANS[NFILE←NFILE+1]←GETCHAN)<0 THEN EOF←TRUE
ELSE
BEGIN
PRSFIL(""); PRSFIL(GETSTRING);
OPEN(CHANS[NFILE],DEVPRS,8,19,0,1,BRCHAR,EOF);
LOOKUP(CHANS[NFILE],FILPRS,FLAG);
IF FLAG THEN EOF←TRUE;
END;
MARKMESS;
END;
[DDINIT_] ;
[SCREEN_]
BEGIN
REAL XL,YL,XH,YH;
XL←GETREAL; YL←GETREAL; XH←GETREAL; YH←GETREAL;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PSCREE(XL,YL,XH,YH);
["F"]["T"] PSCREE(YH,XL,YL,XH) END;
END;
[DRKEN_] PDRKEN;
[LITEN_] PLITEN;
[INVEN_] PINVEN;
[DOT_] BEGIN REAL X,Y; X←GETREAL; Y←GETREAL;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PDOT(X,Y); ["F"]["T"] PDOT(Y,X) END;
END;
[LINE_]
BEGIN
REAL XL,YL,XH,YH;
XL←GETREAL; YL←GETREAL; XH←GETREAL; YH←GETREAL;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PLINE(XL,YL,XH,YH);
["F"]["T"] PLINE(YL,XL,YH,XH) END;
END;
[RECTAN_]
BEGIN
REAL XL,YL,XH,YH;
XL←GETREAL; YL←GETREAL; XH←GETREAL; YH←GETREAL;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PRECTA(XL,YL,XH,YH);
["F"]["T"] PRECTA(YL,XL,YH,XH) END;
END;
[ELLIPS_]
BEGIN
REAL XL,YL,XH,YH;
XL←GETREAL; YL←GETREAL; XH←GETREAL; YH←GETREAL;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PELLIP(XL,YL,XH,YH);
["F"]["T"] PELLIP(YL,XL,YH,XH) END;
END;
[POLYGO_]
BEGIN
INTEGER N,I;
REAL ARRAY X,Y[1:N←GETINT];
FOR I←1 STEP 1 UNTIL N DO
BEGIN X[I]←GETREAL; Y[I]←GETREAL; END;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PPOLYG(N,X[1],Y[1]);
["F"]["T"] PPOLYG(N,Y[1],X[1]) END;
END;
[TXTPOS_]
BEGIN
REAL XL,YL,XS,YS,DXS,DYS;
XL←GETREAL; YL←GETREAL; XS←GETREAL; YS←GETREAL; DXS←GETREAL; DYS←GETREAL;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PTXTPO(XL,YL,XS,YS,DXS,DYS);
["F"]["T"] PTXTPO(YL,XL,DYS,DXS,YS,XS) END;
END;
[TEXT_] PTEXT(GETSTRING);
[TEXTD_] PTEXTD(GETSTRING);
[FNTSEL_] BEGIN
INTEGER F; STRING FNTNAM;
F←GETINT; FNTNAM←GETSTRING;
IF FHD[F,FNTHIG]=-1 THEN
BEGIN
PRSFIL(""); PRSFIL(".FNT[XGP,SYS]");
WHILE FNTSEL(F,FNTNAM,FHD[F,0])<0 DO
BEGIN
PRINT("COULDN'T GET ",DEVPRS,":",FILPRS); CRLF;
PRINT("Try again:");
PRSFIL(""); PRSFIL(".FNT[XGP,SYS]");
FNTNAM←INCHWL;
END;
END;
END;
[FNTPOS_] BEGIN
REAL TX,TY; REAL XL,YL,XH,YH;
PSCREM(XL,YL,XH,YH);
IF DENS="F"∨DENS="T" THEN BEGIN XL↔YL; XH↔YH; YL↔YH; END;
TX←GETREAL; TY←GETREAL;
FXP←XPL+(XPH-XPL)*(TX-XL)/(XH-XL);
FYP←YPH+(YPL-YPH)*(TY-YL)/(YH-YL);
FXS←GETREAL; FYS←GETREAL;
FDXS←GETREAL; FDYS←GETREAL;
END;
[FNTEXT_] BEGIN
INTEGER XP,YP,CH,FNT; STRING TXT;
XP←GETREAL; YP←GETREAL;
FNT←GETINT; TXT←GETSTRING;
WHILE LENGTH(TXT)>0 DO
BEGIN
CH←LOP(TXT);
CASE DENS OF
BEGIN
["H"]["D"] CHRTRN(FNT,CH,DIA[0],FYP-YP*FYS-XP*FDYS,
FXP+XP*FXS+YP*FDXS,FXS,FYS,FDXS,FDYS);
["B"]["E"] CHRTRN(FNT,CH,PIC[0],FYP-YP*FYS-XP*FDYS,
FXP+XP*FXS+YP*FDXS,FXS,FYS,FDXS,FDYS);
["T"] CHRTRN(FNT,CH,PIC[0],PIC[PCLN]-1-(FXP+XP*FXS+YP*FDXS),
FYP-YP*FYS-XP*FDYS,-FDYS,FDXS,-FYS,FXS);
["F"] CHRTRN(FNT,CH,DIA[0],DIA[PCLN]-1-(FXP+XP*FXS+YP*FDXS),
FYP-YP*FYS-XP*FDYS,-FDYS,FDXS,-FYS,FXS)
END;
XP←XP+(FHD[FNT,CH] LSH -18);
END;
END;
[FNTLIN_] BEGIN
REAL ARRAY X,Y[1:6];
REAL XL,YL,XH,YH,TH,DX,DY,D; INTEGER I;
XL←GETREAL; YL←GETREAL; XH←GETREAL; YH←GETREAL; TH←GETREAL;
DX←XH-XL; DY←YH-YL; D←SQRT(DX↑2+DY↑2);
DX←0.499*TH*DX/D; DY←0.499*TH*DY/D;
X[1]←XL-DX; Y[1]←YL-DY;
X[2]←XL-DY; Y[2]←YL+DX;
X[3]←XH-DY; Y[3]←YH+DX;
X[4]←XH+DX; Y[4]←YH+DY;
X[5]←XH+DY; Y[5]←YH-DX;
X[6]←XL+DY; Y[6]←YL-DX;
PSCREM(XL,YL,XH,YH);
IF DENS="F"∨DENS="T" THEN BEGIN XL↔YL; XH↔YH; YL↔YH; END;
FOR I←1 STEP 1 UNTIL 6 DO
BEGIN
DX←FXP+X[I]*FXS+Y[I]*FDXS;
DY←FYP-Y[I]*FYS-X[I]*FDYS;
X[I]←(DX-XPL)*(XH-XL)/(XPH-XPL)+XL;
Y[I]←(DY-YPH)*(YH-YL)/(YPL-YPH)+YL;
END;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PPOLYG(6,X[1],Y[1]);
["F"]["T"] PPOLYG(6,Y[1],X[1])
END;
END;
ELSE
BEGIN
STRING A; INTEGER K,L,M; INTEGER ARRAY INT[1:10];
A←ARG[CMD]; K←0;
WHILE LENGTH(A)>0∧A≠"→" DO
CASE LOP(A) OF
BEGIN
["I"] INT[K←K+1]←GETINT;
["R"] INT[K←K+1]←GETINT;
["S"] GETSTRING;
["A"] BEGIN L←INTSCAN(A,M); FOR M←1 STEP 1 UNTIL INT[L] DO GETINT; END;
ELSE PRINT("bad arg ",CMD,'15&'12)
END;
IF LENGTH(A)>0 ∧ LOP(A)="→" THEN
BEGIN
WHILE LENGTH(A)>0 DO
CASE LOP(A) OF
BEGIN
["I"] ;
["R"] ;
["S"] ;
["A"] ;
ELSE PRINT("bad return ",CMD,'15&'12)
END;
MARKMESS;
END;
END
END;
END "GRAPHICS";
WHILE CHANS[NFILE]>0 DO BEGIN RELEASE(CHANS[NFILE]); NFILE←NFILE-1; END;
END "PICJOB";
CASE DENS OF
BEGIN
["H"]["D"]
SQTILE(DIA[0],0,0,(YZ+YCMP-1)%YCMP,(XZ+XCMP-1)%XCMP,YCMP,XCMP,
PIC[0],((Y0-YOFF)-YZ%2)%YCMP,
((X0-XOFF)-XZ%2)%XCMP);
["F"]
SQTILE(DIA[0],0,0,(XZ+XCMP-1)%XCMP,(YZ+YCMP-1)%YCMP,XCMP,YCMP,
PIC[0],PIC[PCLN]-XZ%XCMP-((X0-XOFF)-XZ%2)%XCMP,
((Y0-YOFF)-YZ%2)%YCMP);
["B"]["E"]["T"]
END;
END;
END "GRAPHICS ESCAPE";
ENDC
IFC MAXESCAPE>0 THENC
ELSE
FOR J←ESCX[I-1] STEP 1 UNTIL ESCX[I] DO FOR K←-2 STEP 1 UNTIL 2 DO
CASE DENS OF
BEGIN
["H"]["D"] ADDEL(PIC[0],(Y0-YOFF+K)%YCMP,(J-XOFF)%XCMP,1);
["B"]["E"] PUTEL(PIC[0],Y0-YOFF+K,J-XOFF,1);
["F"] ADDEL(PIC[0],PIC[PCLN]-(J-XOFF)%XCMP,(Y0-YOFF+K)%YCMP,1);
["T"] PUTEL(PIC[0],PIC[PCLN]-(J-XOFF),Y0-YOFF+K,1)
END
END;
END "ESCAPE CODE INTERPRETER";
ENDC
IFC MAXESCAPE>0 THENC ESCHIT←1; ENDC
XPOS←LMAR;
FOR I←1 STEP 1 UNTIL 20 DO IDPB(0,TXTPNT);
TXTPNT←POINT(7,DBUF,-1);
YPOS←YPOS-YL;
LINLEN←0;
WHILE ILDB(TXTPNT)>0 DO
BEGIN "ASSLP"
CASE LDB(TXTPNT) OF
BEGIN
[0] ;
['177] CASE ILDB(TXTPNT) OF
BEGIN
['1] CASE ILDB(TXTPNT) OF
BEGIN
[0][1][2][3][4][5][6][7][8]
[9][10][11][12][13][14][15]
BEGIN
FNTN←LDB(TXTPNT);
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←0;
END;
['43] BASE←((ILDB(TXTPNT) LSH 29) ASH -29);
['52] BASE←BASE+((ILDB(TXTPNT) LSH 29) ASH -29);
['40]
BEGIN
XPOS←ILDB(TXTPNT)*128+ILDB(TXTPNT);
END;
['41]
BEGIN
INTEGER XP,YP,XNEW;
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29))
%YCMP;
XNEW←XPOS+ILDB(TXTPNT)*128+ILDB(TXTPNT);
FOR XP←XPOS STEP 1 UNTIL XNEW DO
CASE DENS OF
BEGIN
["H"] ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
["D"] ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
["B"]["E"] PUTEL(PIC[0],YP,XP-XOFF,1);
["F"] ADDEL(PIC[0],PIC[PCLN]-(XP-XOFF)%XCMP,YP,1);
["T"] PUTEL(PIC[0],PIC[PCLN]-(XP-XOFF),YP,1)
END;
XPOS←XNEW;
END;
['42] YPOS←YPOS+YU+ILDB(TXTPNT);
['45]
BEGIN
INTEGER N,J;
N←ILDB(TXTPNT);
FOR J←1 STEP 1 UNTIL N DO IBP(TXTPNT);
END;
['46] LUND←XPOS;
['47]
BEGIN
INTEGER XP,YP;
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29))
%YCMP;
FOR XP←LUND STEP 1 UNTIL XPOS DO
CASE DENS OF
BEGIN
["H"]["D"] ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
["B"]["E"] PUTEL(PIC[0],YP,XP-XOFF,1);
["F"] ADDEL(PIC[0],PIC[PCLN]-(XP-XOFF)%XCMP,YP,1);
["T"] PUTEL(PIC[0],PIC[PCLN]-(XP-XOFF),YP,1)
END;
END;
['50] INTERCHAR←ILDB(TXTPNT);
['51]
BEGIN
INTEGER XP,YP,TH,THK;
THK←ILDB(TXTPNT);
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29));
FOR XP←LUND STEP 1 UNTIL XPOS DO
FOR TH←THK-1 STEP -1 UNTIL 0 DO
CASE DENS OF
BEGIN
["H"]["D"] ADDEL(PIC[0],(YP+TH)%YCMP,(XP-XOFF)%XCMP,1);
["B"]["E"] PUTEL(PIC[0],(YP+TH)%YCMP,XP-XOFF,1);
["F"] ADDEL(PIC[0],PIC[PCLN]-(XP-XOFF)%XCMP,(YP+TH)%YCMP,1);
["T"] PUTEL(PIC[0],PIC[PCLN]-(XP-XOFF),YP+TH,1)
END;
END
END;
[2] XPOS←XPOS+((ILDB(TXTPNT) LSH 29) ASH -29);
[3] YPOS←ILDB(TXTPNT)*128+ILDB(TXTPNT)-YL;
[4]
BEGIN
INTEGER J,K,X0,Y0,N,W,DX;
Y0←ILDB(TXTPNT)*128+ILDB(TXTPNT);
X0←ILDB(TXTPNT)*128+ILDB(TXTPNT);
DX←((ILDB(TXTPNT)*16384+ILDB(TXTPNT)*128+ILDB(TXTPNT))
LSH 15) ASH -15;
X0←(X0 ASH 9)+(DX MIN 0);
N←ILDB(TXTPNT)*128+ILDB(TXTPNT);
W←ILDB(TXTPNT)*128+ILDB(TXTPNT);
FOR J←0 STEP 1 UNTIL N-1 DO
BEGIN
FOR K←W-1 STEP -1 UNTIL 0 DO
CASE DENS OF
BEGIN
["H"]["D"] ADDEL(PIC[0],(J+Y0-YOFF)%YCMP,
(K+(X0 ASH -9)-XOFF)%XCMP,1);
["B"]["E"] PUTEL(PIC[0],J+Y0-YOFF,
K+(X0 ASH -9)-XOFF,1);
["F"] ADDEL(PIC[0],
PIC[PCLN]-(K+(X0 ASH -9)-XOFF)%XCMP,
(J+Y0-YOFF)%YCMP,1);
["T"] PUTEL(PIC[0],
PIC[PCLN]-(K+(X0 ASH -9)-XOFF),
J+Y0-YOFF,1)
END;
X0←X0+DX;
END;
END;
[5]
BEGIN
FNTN←ILDB(TXTPNT);
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←0;
END;
[6]
BEGIN
INTEGER PREVHT;
PREVHT←FTB+BASE;
FNTN←ILDB(TXTPNT);
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←(IF LINLEN=0 THEN 0 ELSE PREVHT-FTB);
END;
[7]['10]['13]
['16]['17]['20]['21]['22]['23]['24]['25]['26]
['27]['30]['31]['32]['33]['34]['35]['36]['37] ;
ELSE
BEGIN
IFC MAXESCAPE>0 THENC
IF ESCHIT<NESCAPE ∧ BYT(TXTPNT)>ESCL[ESCHIT+1]
THEN ESCHIT←ESCHIT+2;
IF ESCHIT>NESCAPE ∨ BYT(TXTPNT)<ESCF[ESCHIT]
∨ BYT(TXTPNT)>ESCL[ESCHIT+1] THEN
ENDC
CASE DENS OF
BEGIN
["H"] CHR3X2(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["F"] CHR3Y4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["D"] CHR6X4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["B"]["E"] CHR1X1(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["T"] CHRPED(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP)
END;
XPOS←XPOS+(FHD[FNTN,LDB(TXTPNT)] LSH -18)+INTERCHAR+UINTERCHAR;
LINLEN←LINLEN+1;
END
END;
['12] YPOS←YPOS+YU+XLINE;
['15] XPOS←LMAR;
['11]
BEGIN
INTEGER BLANW;
BLANW←(FHD[FNTN," "] LSH -18)+INTERCHAR+UINTERCHAR;
XPOS←LMAR+((9*BLANW+XPOS-LMAR-1)%(8*BLANW))*8*BLANW;
LINLEN←LINLEN+1;
END;
['14] BEGIN XPOS←LMAR; YPOS←TMAR; END;
ELSE
BEGIN
IFC MAXESCAPE>0 THENC
IF ESCHIT<NESCAPE ∧ BYT(TXTPNT)>ESCL[ESCHIT+1]
THEN ESCHIT←ESCHIT+2;
IF ESCHIT>NESCAPE ∨ BYT(TXTPNT)<ESCF[ESCHIT]
∨ BYT(TXTPNT)>ESCL[ESCHIT+1] THEN
ENDC
CASE DENS OF
BEGIN
["H"] CHR3X2(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["F"] CHR3Y4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["D"] CHR6X4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["B"]["E"] CHR1X1(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["T"] CHRPED(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP)
END;
XPOS←XPOS+(FHD[FNTN,LDB(TXTPNT)] LSH -18)+INTERCHAR+UINTERCHAR;
LINLEN←LINLEN+1;
END
END;
END"ASSLP";
END "ASSEMBLE";
END "NOTEOF";
comment display page;
IF ¬SPOOLFLAG THEN
BEGIN "SPOOLF"
SAFE INTEGER ARRAY DDB[2:(PIC[BYBI] MAX 2),
0:IF DENS="B"∨DENS="T"∨DENS="E"∨OWNCH
THEN 0 ELSE DDSIZ];
IF WHITELET THEN
BEGIN
INTEGER ARRAY TRANS[0:PIC[BMAX]];
J←PIC[BMAX]; K←J-(J LSH -1);
FOR I←0 STEP 1 UNTIL J DO
TRANS[I]←I XOR K;
PERBIT(PIC[0],TRANS[0]);
END;
DDINIT;
IF ¬OWNCH THEN
BEGIN
MAPGRY(IF DENS="D" THEN 1.5 ELSE 1,PIC[BYBI],TRUE);
GRAY(PIC[0]);
FOR I←2 STEP 1 UNTIL PIC[BYBI] DO DDSTOR(DDB[I,0]);
CASE PIC[BYBI] OF
BEGIN
[1] VID1(PIC[0],DBUF);
[3] VID3(PIC[0],DDB[3,0],DDB[2,0],DBUF);
[4] VID4(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF);
[5] VID5(PIC[0],DDB[5,0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF)
END;
FOR J←1,1 DO DPYUP(SYNMAP(0));
FOR I←1 STEP 1 UNTIL PIC[BYBI]-1 DO IF SYNMAP(I)>0 THEN
FOR J←1,1 DO DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
PRINT(" DONE"); IF HELPACT THEN FIRST2; CRLF;
END
ELSE
BEGIN
VIDONE(PIC[0],IF PIC[BYBI]>2 THEN '7776 ELSE '7777);
DPYUP(-1); DPYUP(-1);
END;
END "SPOOLF";
IF DENS="H"∨DENS="T" THEN FPN←FPN+FPNR+.5 ELSE
IF DENS="F"∨DENS="B" THEN FPN←(PN←FPN)+1 ELSE
IF DENS="E" THEN FPN←FPN+FPNR+1/4.5 ELSE
IF DENS="D" THEN FPN←(PN←FPN)+2;
END "NONZERO";
END "PAGES"
UNTIL PN<0;
END "PICTURE";
END "DENSITY";
END "FILE";
END IFC MAXESCAPE>0 THENC "XGPSYG" ELSEC "XGPSYN" ENDC;